home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-06 / qb_ipx.zip / IPXS.BAS < prev    next >
BASIC Source File  |  1992-08-03  |  8KB  |  301 lines
  1. '--------------------------------------------------------------------'
  2. '             IPX Send And Receive in QuickBASIC 4.0                 '
  3. '                          By David Rice                             '
  4. '--------------------------------------------------------------------'
  5. '
  6. DECLARE SUB RelenquishControl ()
  7. DECLARE SUB SocketListen ()
  8. DECLARE SUB CloseSocket (Socket%)
  9. DECLARE SUB SendPacket (CompleteCode%, InUseFlag%)
  10. DECLARE SUB OpenSocket (Socket%, Status%, SocketNumberReturned%)
  11. DECLARE SUB IPXMarker (Interval%)
  12. DECLARE SUB GetMyAddress (MyNetwork$, MyNode$, MyNetworkHex$, MyNodeHex$)
  13. DECLARE FUNCTION SplitWordLo% (TheWord%)
  14. DECLARE FUNCTION SplitWordHi% (TheWord%)
  15. DECLARE FUNCTION IPXInstalled% ()
  16. DECLARE FUNCTION TurnToHex$ (Variable$)
  17. DEFINT A-Z
  18. '
  19. '           Choose the socket number to use. You MUST pick one
  20. '        that no other program is using! Call Novell to see which
  21. '        socket you may use.
  22. '
  23. CONST Socket = &H5555
  24. CLS
  25. '
  26. '           Define the DOS Interrupt registers.
  27. '
  28. TYPE RegTypeX
  29.     AX    AS INTEGER
  30.     BX    AS INTEGER
  31.     CX    AS INTEGER
  32.     DX    AS INTEGER
  33.     BP    AS INTEGER
  34.     SI    AS INTEGER
  35.     DI    AS INTEGER
  36.     FLAGS AS INTEGER
  37.     DS    AS INTEGER
  38.     ES    AS INTEGER
  39. END TYPE
  40. '                                        
  41. '              This is the Event Control Block Structure.
  42. '
  43. TYPE ECBStructure
  44.     LinkAddressOff AS INTEGER
  45.     LinkAddressSeg AS INTEGER
  46.     ESRAddressOff  AS INTEGER
  47.     ESRAddressSeg  AS INTEGER
  48.     InUse       AS STRING * 1
  49.     CompCode    AS STRING * 1
  50.     SockNum     AS INTEGER
  51.     IPXWorkSpc  AS SINGLE
  52.     DrvWorkSpc  AS STRING * 12
  53.     ImmAdd      AS STRING * 6
  54.     FragCount   AS INTEGER
  55.     FragAddOfs  AS INTEGER
  56.     FragAddSeg  AS INTEGER
  57.     FragSize    AS INTEGER
  58. END TYPE
  59. '
  60. '              This is the IPX Packet Structure.
  61. '
  62. TYPE IPXHeader
  63.     Checksum    AS INTEGER
  64.     Length      AS INTEGER
  65.     Control     AS STRING * 1
  66.     PacketType  AS STRING * 1
  67.     DestNet     AS STRING * 4
  68.     DestNode    AS STRING * 6
  69.     DestSocket  AS STRING * 2
  70.     SourNet     AS STRING * 4
  71.     SourNode    AS STRING * 6
  72.     SourSock    AS STRING * 2
  73.     DataGram    AS STRING * 546
  74. END TYPE
  75. '
  76. TYPE FullNetAddress
  77.     NetWork     AS STRING * 4
  78.     Node        AS STRING * 6
  79. END TYPE
  80. '
  81. '              Define the Send and Receive buffers.
  82. '
  83. DIM SHARED IPXS AS IPXHeader, IPXR AS IPXHeader
  84. DIM SHARED ECBS AS ECBStructure, ECBR AS ECBStructure
  85. DIM SHARED InReg AS RegTypeX, OutReg AS RegTypeX
  86. DIM SHARED GetMyAdd AS FullNetAddress
  87. '
  88. IF IPXInstalled = 0 THEN
  89.     PRINT "IPX.COM is not installed."
  90.     END
  91. END IF
  92. '
  93. '        SEND IPX
  94. '
  95. IPXS.Checksum = 0
  96. IPXS.Length = LEN(IPXS)
  97. IPXS.Control = CHR$(0)
  98. IPXS.PacketType = CHR$(0)
  99. IPXS.DestNet = STRING$(4, &H0): '       default network
  100. IPXS.DestNode = STRING$(6, &HFF): '     broadcast FFFFFFFF
  101. IPXS.DestSocket = MKI$(Socket)
  102. IPXS.SourSock = MKI$(&H740)
  103. IPXS.DataGram = "Hello there!"
  104. '
  105. ECBS.LinkAddressOff = 0
  106. ECBS.LinkAddressSeg = 0
  107. ECBS.ESRAddressOff = 0
  108. ECBS.ESRAddressSeg = 0
  109. ECBS.SockNum = Socket
  110. ECBS.ImmAdd = STRING$(6, &HFF)
  111. ECBS.FragCount = &H1
  112. ECBS.FragAddOfs = VARPTR(IPXS)
  113. ECBS.FragAddSeg = VARSEG(IPXS)
  114. ECBS.FragSize = LEN(IPXS)
  115. '
  116. CALL GetMyAddress(MyNetwork$, MyNode$, MyNetworkHex$, MyNodeHex$)
  117. '
  118. CALL OpenSocket(Socket, Status, SocketNumberReturned)
  119. PRINT "Status: "; Status; " On Socket Number: "; SocketNumberReturned
  120. PRINT "My Address is: "; MyNetworkHex$, MyNodeHex$
  121. '
  122. '              Send the packet.
  123. '
  124. IPXMarker (StartInterval%)
  125. CALL SendPacket(CompleteCode, InUseFlag)
  126. IPXMarker (StopInterval%)
  127. PRINT "Complete Code: "; HEX$(CompleteCode); " In Use Flag: "; HEX$(InUseFlag)
  128. PRINT USING "Send took ##### clock ticks"; StopInterval% - StartInterval%
  129. '
  130. '              Surrender a tiny amount of CPU time.
  131. '
  132. DO
  133.     CALL RelenquishControl
  134.     InUseFlag = ASC(ECBS.InUse)
  135. LOOP UNTIL InUseFlag = 0
  136. '
  137. '              Now wait for confirmation.
  138. '
  139. ECBR.LinkAddressOff = 0
  140. ECBR.LinkAddressSeg = 0
  141. ECBR.ESRAddressOff = 0
  142. ECBR.ESRAddressSeg = 0
  143. ECBR.SockNum = Socket
  144. ECBR.FragCount = &H1
  145. ECBR.FragAddOfs = VARPTR(IPXR)
  146. ECBR.FragAddSeg = VARSEG(IPXR)
  147. ECBR.FragSize = LEN(IPXR)
  148. '
  149. PRINT
  150. PRINT "Packet sent. Now I'm listening for confirmation."
  151. PRINT "Hit Any Key To Stop."
  152. PRINT
  153. InUseFlag = 0
  154. '
  155. '           Asx IPX.COM to listen for a packet.
  156. '
  157. CALL SocketListen
  158. '
  159. '           Now wait for the packet.
  160. '
  161. DO
  162.     CompleteCode = ASC(ECBR.CompCode)
  163.     InUseFlag = ASC(ECBR.InUse)
  164.     IF INKEY$ <> "" THEN EXIT DO
  165. LOOP UNTIL InUseFlag = 0
  166. '
  167. SNet$ = TurnToHex$(IPXR.SourNet)
  168. SNode$ = TurnToHex$(IPXR.SourNode)
  169. SSoc$ = TurnToHex$(IPXR.SourSock)
  170. '
  171. PRINT "Complete Code: "; HEX$(CompleteCode)
  172. PRINT "In Use Flag: "; HEX$(InUseFlag)
  173. PRINT "Source Network: "; SNet$
  174. PRINT "Source Node: "; SNode$
  175. PRINT "Source Socket: "; SSoc$
  176. PRINT "Data: "; IPXR.DataGram
  177. CALL CloseSocket(Socket%)
  178.  
  179. SUB CloseSocket (Socket%)
  180.     InReg.BX = 1
  181.     InReg.AX = 0
  182.     InReg.DX = Socket
  183.     CALL InterruptX(&H7A, InReg, OutReg)
  184. END SUB
  185.  
  186. SUB GetMyAddress (MyNetwork$, MyNode$, MyNetworkHex$, MyNodeHex$)
  187.     InReg.BX = &H9
  188.     InReg.ES = VARSEG(GetMyAdd)
  189.     InReg.SI = VARPTR(GetMyAdd)
  190.     CALL InterruptX(&H7A, InReg, OutReg)
  191.     MyNetwork$ = GetMyAdd.NetWork
  192.     MyNode$ = GetMyAdd.Node
  193.     MyNetworkHex$ = TurnToHex$(MyNetwork$)
  194.     MyNodeHex$ = TurnToHex$(MyNode$)
  195. END SUB
  196.  
  197. SUB IPXCancel (CompleteCode%)
  198.     InReg.BX = 6
  199.     InReg.ES = VARSEG(ECBS)
  200.     InReg.SI = VARPTR(ECBS)
  201.     CALL InterruptX(&H7A, InReg, OutReg)
  202.     CompleteCode = SplitWordLo%(OutReg.AX)
  203. END SUB
  204.  
  205. FUNCTION IPXInstalled%
  206.     InReg.AX = &H7A00
  207.     CALL InterruptX(&H2F, InReg, OutReg)
  208.     AL = SplitWordLo(OutReg.AX)
  209.     IF AL = &HFF THEN IPXInstalled = 1 ELSE IPXInstalled = 0
  210. END FUNCTION
  211.  
  212. SUB IPXMarker (Interval%)
  213.     InReg.BX = 8
  214.     CALL InterruptX(&H7A, InReg, OutReg)
  215.     Interval = OutReg.AX
  216. END SUB
  217.  
  218. SUB IPXSchedule (DelayTicks%)
  219.     InReg.AX = DelayTicks%
  220.     InReg.BX = 5
  221.     InReg.ES = VARSEG(ECBS)
  222.     InReg.SI = VARPTR(ECBS)
  223.     CALL InterruptX(&H7A, InReg, OutReg)
  224.     CompleteCode = ASC(ECBS.CompCode)
  225.     InUseFlag = ASC(ECBS.InUse)
  226. END SUB
  227.  
  228. SUB OpenSocket (Socket%, Status%, SocketNumberReturned%)
  229.     InReg.BX = 0
  230.     InReg.AX = 0
  231.     InReg.DX = Socket
  232.     CALL InterruptX(&H7A, InReg, OutReg)
  233.     Status = SplitWordLo(OutReg.AX)
  234.     SocketNumberReturned = OutReg.DX
  235.     '
  236.     '           Completion status
  237.     '                    00 successful
  238.     '                    FF open already
  239.     '                    FE socket table is full
  240. END SUB
  241.  
  242. SUB RelenquishControl
  243.     DEFINT A-Z
  244.     InReg.AX = 0
  245.     InReg.BX = &HA
  246.     CALL InterruptX(&H7A, InReg, OutReg)
  247. END SUB
  248.  
  249. SUB SendPacket (CompleteCode%, InUseFlag%)
  250.     InReg.BX = 3
  251.     InReg.ES = VARSEG(ECBS)
  252.     InReg.SI = VARPTR(ECBS)
  253.     CALL InterruptX(&H7A, InReg, OutReg)
  254.     CompleteCode = ASC(ECBS.CompCode)
  255.     InUseFlag = ASC(ECBS.InUse)
  256.     '
  257.     '        Error codes:
  258.     '              00    sent
  259.     '              FC    canceled
  260.     '              FD    malformed packet
  261.     '              FE    no listener (undelivered)
  262.     '              FF    hardware failure
  263. END SUB
  264.  
  265. SUB SocketListen
  266.     InReg.BX = 4
  267.     InReg.ES = VARSEG(ECBR)
  268.     InReg.SI = VARPTR(ECBR)
  269.     CALL InterruptX(&H7A, InReg, OutReg)
  270.     CompleteCode = ASC(ECBR.CompCode)
  271.     InUseFlag = ASC(ECBR.InUse)
  272.     '
  273.     '        Completion codes:
  274.     '              00    received
  275.     '              FC    canceled
  276.     '              FD    packet overflow
  277.     '              FF    socket was closed
  278. END SUB
  279.  
  280. FUNCTION SplitWordHi (TheWord%)
  281.     SplitWordHi = (TheWord% AND &HFF00) / 256
  282. END FUNCTION
  283.  
  284. FUNCTION SplitWordLo (TheWord%)
  285.     SplitWordLo = (TheWord% AND &HFF)
  286. END FUNCTION
  287.  
  288. FUNCTION TurnToHex$ (Variable$)
  289.     Temp$ = ""
  290.     FOR Byte = 1 TO LEN(Variable$)
  291.         Value! = ASC(MID$(Variable$, Byte, 1))
  292.         IF Value! < 15 THEN
  293.             Temp$ = Temp$ + "0" + HEX$(Value!)
  294.         ELSE
  295.             Temp$ = Temp$ + HEX$(Value!)
  296.         END IF
  297.     NEXT
  298.     TurnToHex$ = Temp$
  299. END FUNCTION
  300.  
  301.